vcolobasic = 'w+/rb,gr+/r'
SAVE SCREEN TO vscreen
SET COLO TO W+/R
@ 24,0 CLEAR
STORE 0 TO vadd
DO BOX2 WITH 22,20,"DO YOU WANT TO ? :","ADD PROCEDURE","CANCEL",'GR+','RB','GR+','R',VADD,.F.,.T.
IF LASTKEY()=27 .OR. VADD=2
   REST SCREEN FROM vscreen
   RETURN
ENDIF
REST SCREEN FROM vscreen
SET COLO TO W+/G
@ 12,5 CLEAR TO 16,50
@ 12,5 TO 16,50 DOUBLE
@ 12,17 SAY '[Input Main Area]'
@ 13,6 SAY 'Main Area Code :'
@ 14,6 say 'Main Area Name :'
set colo to /w+
@ 13,23 say space(1)
@ 14,23 say space(24)
STORE SPACE(1) TO vcode
STORE '1' TO vsubcode
STORE SPACE(16) TO vsubname
STORE SPACE(24) TO vname
SAVE SCREEN TO VSCREEN1
DO WHILE .T.
   SET INTEN ON
   @ 13,23 GET vcode PICT '!'
   READ
   if lastkey()=27
      exit
   endif
   IF vcode =  SPACE(1)
      REST SCREEN FROM VSCREEN1
      LOOP
   ELSE
      IF vcode = 'A'
         SET COLO TO W+/R
         @ 24,0 CLEA
         @ 24,16 SAY "You are forbiden to fill 'A' for Main Area Code!"
         @ 23,0 say ''
         wait ''
         REST SCREEN FROM vscreen1
         LOOP
      ENDIF
   ENDIF
   GO TOP
   LOCA FOR area_code = vcode
   IF .NOT. EOF()
      SET COLO TO W+*/R
      @ 24,0 CLEA
      @ 24,7 SAY 'This Main Area Code is already exist, press any key to continue ..!'
      @ 23,0 SAY ''
      WAIT ''
      REST SCREEN FROM vscreen1
      LOOP
   ENDIF
   @ 14,23 GET vname PICT '@!'
   READ
   IF vname = SPACE(24)
      REST SCREEN FROM VSCREEN1
      LOOP
   ENDIF
   GO TOP
   LOCA FOR MAIN_AREA = VNAME
   IF .NOT. EOF()
      SET COLO TO W+*/R
      @ 24,0 CLEA
      @ 24,10 SAY 'This Main Area is already exist, press any key to continue ..!'
      @ 23,0 SAY ''
      WAIT ''
      REST SCREEN FROM vscreen1
      LOOP
   ENDIF
   IF FIL_LOCK()
      APPE BLANK
      IF REC_LOCK()
         REPL area_code WITH vcode,main_area WITH vname
      ENDIF
      UNLOCK
   ENDIF
   EXIT
ENDDO
if lastkey()=27
   retur
endif
SET COLO TO W+/G
@ 12,5 CLEAR TO 18,50
@ 12,5 TO 18,50 DOUBLE
@ 12,17 SAY '[Input Main Area]'
@ 13,6 SAY 'Main Area Code : '+vcode
@ 14,6 say 'Main Area Name : '+vname
*CLOS DATA
SELE 3
USE &DR&F3 INDE &DR&F3
vfile = 'SUB_ARE'+vcode+'.DBF'
COPY STRU TO &DR&vfile
sele 3
USE &DR&F3 INDE &DR&F3
SAVE SCREEN TO vscreen2
DO WHILE .T.
   SELE 3
   USE &DR&F3 INDE &DR&F3
*   REST SCREEN FROM vscreen2
   SET COLO TO r+/G
   @ 15,6 clear to 17,49
   @ 15,6 SAY 'Sub Area Code  :'
   @ 16,6 say 'Sub Area Name  :'
   set colo to /w+
*   @ 15,23 say space(1)
   @ 16,23 say space(16)
   @ 15,23 GET vsubcode PICT '!'
   READ
   if lastkey()=27
      exit
   endif
   if vsubcode= ' '
      loop
   endif

   LY1=SAVESCREEN(0,0,24,79)
   vrec=recno()
   GO TOP
   LOCA FOR area_code+sub_areaco = vcode+vsubcode
   IF .NOT. EOF()
      SET COLO TO W+*/R
      @ 24,0 CLEA
      @ 24,26 SAY 'This code is already exist !'
      @ 23,0 SAY ''
      WAIT ''
      RESTSCREEN(0,0,24,79,LY1)
      LOOP
   ENDIF
   GO vrec
   @ 16,23 GET vsubname PICT '@!'
   READ
   store 'Y' to vright,vmore
   do get_optn with 'SAVE (Y/N)','YN',vright
   IF vright # 'Y'
      LOOP
   ELSE
      IF FIL_LOCK()
         APPE BLANK
         IF REC_LOCK()
            REPL sub_areaco WITH vsubcode,sub_area WITH vsubname,area_code with vcode
            use &dr&vfile
            IF FIL_LOCK()
               APPE BLANK
               IF REC_LOCK()
                  REPL sub_areaco WITH vsubcode,sub_area WITH vsubname,area_code WITH vcode
               ENDIF
            ENDIF
         ENDIF
         UNLOCK
*         CLOS DATA
      ENDIF
   ENDIF
   do get_optn with 'ADD MORE SUB AREA ?(Y/N)','YN',vmore
   IF vmore # 'Y'
      EXIT
   ELSE
      VSUB=VAL(VSUBCODE)
      VSUB=VSUB+1
      VSUBCODE=STR(VSUB,1)
      LOOP
   ENDIF
ENDDO
SET COLO TO &vcolobasic
REST SCREEN  FROM VSCREEN
kode1=vcode
kode2=vsubcode
MAIN=VNAME
RELE ALL LIKE V*
RETURN
